home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / WASTE 1.1a4 / WASTE Source / WEObjects.p < prev    next >
Encoding:
Text File  |  1994-11-10  |  11.9 KB  |  436 lines  |  [TEXT/PJMM]
  1. unit WEObjects;
  2.  
  3. { WASTE PROJECT: }
  4. { Embedded Objects }
  5.  
  6. { Copyright © 1993-1994 Marco Piovanelli }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.     uses
  11.         WEInterface;
  12.  
  13.     const
  14.  
  15. { result codes }
  16.  
  17.  
  18. { values for WEInstallObjectHandler handlerSelector parameter }
  19.  
  20.         weNewHandler = 'new ';
  21.         weDisposeHandler = 'free';
  22.         weDrawHandler = 'draw';
  23.         weClickHandler = 'clik';
  24.         weCursorHandler = 'curs';
  25.  
  26.     type
  27.  
  28. { A WESoup record is a static description of an object embedded in the text }
  29. { the 'SOUP' flavor is just a collection of WESoup records, each followed }
  30. { by the corresponding object data. }
  31. { This flavor complements the standard TEXT/styl pair. }
  32.  
  33.         WESoup = record
  34.                 soupOffset: LongInt;                    { insertion offset for this object }
  35.                 soupType: OSType;                    { 4-letter tag identifying object type }
  36.                 soupReserved1: LongInt;            { reserved for future use; set to zero }
  37.                 soupDataSize: Size;                    { size of object data (following this record) }
  38.                 soupSize: Point;                            { object height and width, in pixels }
  39.                 soupReserved2: LongInt;            { reserved for future use; set to zero }
  40. { actual object data follows }
  41.             end;  { WESoup }
  42.         WESoupPtr = ^WESoup;
  43.         WESoupHandle = ^WESoupPtr;
  44.  
  45. { A WEObjectDesc record is used to keep track of embedded objects in memory. }
  46. { Notice that the first two fields are an AEDesc record, i.e. "tagged data" }
  47.  
  48.         WEObjectDesc = record
  49.                 objectType: OSType;                        { 4-letter tag identifying object type }
  50.                 objectDataHandle: Handle;            { handle to object data }
  51.                 objectSize: Point;                            { object height and width, in pixels }
  52.                 objectIndex: Integer;                    { precalculated index into object handler table }
  53.                 objectOwner: WEHandle;                { handle to owner WE instance }
  54.                 objectRefCon: LongInt;                    { free for use by object handlers }
  55.             end;  { WEObjectDesc }
  56.         WEObjectDescPtr = ^WEObjectDesc;
  57.         WEObjectDescHandle = ^WEObjectDescPtr;
  58.  
  59. { embedded object functions for use by the client application }
  60.  
  61.     function WEInstallObjectHandler (objectType: OSType;
  62.                                     handlerSelector: OSType;
  63.                                     handler: ProcPtr): OSErr;
  64.  
  65. { accessor functions for use by object handlers }
  66.  
  67.     function WEGetObjectType (hObjectDesc: WEObjectDescHandle): OSType;
  68.     function WEGetObjectDataHandle (hObjectDesc: WEObjectDescHandle): Handle;
  69.     function WEGetObjectSize (hObjectDesc: WEObjectDescHandle): Point;
  70.     function WEGetObjectOwner (hObjectDesc: WEObjectDescHandle): WEHandle;
  71.     function WEGetObjectRefCon (hObjectDesc: WEObjectDescHandle): LongInt;
  72.     procedure WESetObjectRefCon (hObjectDesc: WEObjectDescHandle;
  73.                                     refCon: LongInt);
  74.  
  75. { object management function for WASTE internal use }
  76.  
  77.     function _WENewObject (objectType: OSType;
  78.                                     objectDataHandle: Handle;
  79.                                     hWE: WEHandle;
  80.                                     var hObjectDesc: WEObjectDescHandle): OSErr;
  81.     function _WEFreeObject (hObjectDesc: WEObjectDescHandle): OSErr;
  82.     function _WEDrawObject (hObjectDesc: WEObjectDescHandle): OSErr;
  83.     function _WEClickObject (hitPt: Point;
  84.                                     modifiers: Integer;
  85.                                     clickTime: LongInt;
  86.                                     hObjectDesc: WEObjectDescHandle): Boolean;
  87.     function _WEGetIndObjectType (index: Integer;
  88.                                     var objectType: OSType): OSErr;
  89.  
  90. implementation
  91.  
  92.     const
  93.  
  94.         kUnknownObjectType = -1;                { specifies an object type for which no handlers are installed }
  95.         kDefaultObjectSize = $00200020;        { default object size (32x32 pixels) }
  96.  
  97.     type
  98.  
  99.         WEOHTableElement = record
  100.                 objectType: OSType;                { 4-letter tag identifying object type }
  101.                 newHandler: ProcPtr;
  102.                 freeHandler: ProcPtr;
  103.                 drawHandler: ProcPtr;
  104.                 clickHandler: ProcPtr;
  105.                 cursorHandler: ProcPtr;
  106.             end;  { WEOHTableElement }
  107.         WEOHTableElementPtr = ^WEOHTableElement;
  108.  
  109.         WEOHTable = array[0..0] of WEOHTableElement;
  110.         WEOHTablePtr = ^WEOHTable;
  111.         WEOHTableHandle = ^WEOHTablePtr;
  112.  
  113.     var
  114.  
  115. { static variables }
  116.  
  117.         sHandlerTable: WEOHTableHandle;
  118.         sHandlerCount: Integer;
  119.  
  120.     function WEGetObjectType (hObjectDesc: WEObjectDescHandle): OSType;
  121.     begin
  122.         WEGetObjectType := hObjectDesc^^.objectType;
  123.     end;  { WEGetObjectType }
  124.  
  125.     function WEGetObjectDataHandle (hObjectDesc: WEObjectDescHandle): Handle;
  126.     begin
  127.         WEGetObjectDataHandle := hObjectDesc^^.objectDataHandle;
  128.     end;  { WEGetObjectDataHandle }
  129.  
  130.     function WEGetObjectSize (hObjectDesc: WEObjectDescHandle): Point;
  131.     begin
  132.         WEGetObjectSize := hObjectDesc^^.objectSize;
  133.     end;  { WEGetObjectSize }
  134.  
  135.     function WEGetObjectOwner (hObjectDesc: WEObjectDescHandle): WEHandle;
  136.     begin
  137.         WEGetObjectOwner := hObjectDesc^^.objectOwner;
  138.     end;  { WEGetObjectOwner }
  139.  
  140.     function WEGetObjectRefCon (hObjectDesc: WEObjectDescHandle): LongInt;
  141.     begin
  142.         WEGetObjectRefCon := hObjectDesc^^.objectRefCon;
  143.     end;  { WEGetObjectRefCon }
  144.  
  145.     procedure WESetObjectRefCon (hObjectDesc: WEObjectDescHandle;
  146.                                     refCon: LongInt);
  147.     begin
  148.         hObjectDesc^^.objectRefCon := refCon;
  149.     end;  { WESetObjectRefCon }
  150.  
  151.     function _WELookupObjectType (objectType: OSType): Integer;
  152.  
  153. { look for a WEOHTableElement record for the specified object kind }
  154. { in our private object handler table }
  155.  
  156.         var
  157.             pTable: WEOHTablePtr;
  158.             index: Integer;
  159.     begin
  160.  
  161. { assume no handlers have been installed for this object type }
  162.         _WELookupObjectType := kUnknownObjectType;
  163.  
  164. { do nothing if the Object Handler Table has not been inited yet }
  165.         if (sHandlerTable = nil) then
  166.             Exit(_WELookupObjectType);
  167.  
  168. { scan the Object Handler Table looking for a type match }
  169.         pTable := sHandlerTable^;
  170.         for index := sHandlerCount - 1 downto 0 do
  171.             if (pTable^[index].objectType = objectType) then
  172.                 begin
  173.                     _WELookupObjectType := index;
  174.                     Exit(_WELookupObjectType);
  175.                 end;
  176.  
  177.     end;  { _WELookupObjectType }
  178.  
  179.     function _WEGetIndObjectType (index: Integer;
  180.                                     var objectType: OSType): OSErr;
  181.     begin
  182.         _WEGetIndObjectType := noErr;
  183.         objectType := OSType(0);
  184.  
  185.         if (index >= 0) and (index < sHandlerCount) then
  186.             objectType := sHandlerTable^^[index].objectType
  187.         else
  188.             _WEGetIndObjectType := weUnknownObjectTypeErr;
  189.     end;  { _WEGetIndObjectType }
  190.  
  191.     function CallNewHandler (var defaultObjectSize: Point;
  192.                                     hObjectDesc: WEObjectDescHandle;
  193.                                     newHandler: ProcPtr): OSErr;
  194.     inline
  195.         $205F,                    { movea.l (sp)+, a0 }
  196.         $4E90;                    { jsr (a0) }
  197.  
  198.     function _WENewObject (objectType: OSType;
  199.                                     objectDataHandle: Handle;
  200.                                     hWE: WEHandle;
  201.                                     var hObjectDesc: WEObjectDescHandle): OSErr;
  202.         label
  203.             1;
  204.         var
  205.             pDesc: WEObjectDescPtr;
  206.             index: Integer;
  207.             err: OSErr;
  208.     begin
  209.         _WENewObject := noErr;
  210.         hObjectDesc := nil;
  211.  
  212. { look up the specified object type in the handler table }
  213.         index := _WELookupObjectType(objectType);
  214.  
  215. { create a new relocatable block to hold the object descriptor }
  216.         err := _WEAllocate(SizeOf(WEObjectDesc), kAllocClear, hObjectDesc);
  217.         if (err <> noErr) then
  218.             goto 1;
  219.  
  220. { lock it down }
  221.         HLock(Handle(hObjectDesc));
  222.         pDesc := hObjectDesc^;
  223.  
  224. { fill in the object descriptor }
  225.         pDesc^.objectType := objectType;
  226.         pDesc^.objectDataHandle := objectDataHandle;
  227.         pDesc^.objectSize := Point(kDefaultObjectSize);
  228.         pDesc^.objectIndex := index;
  229.         pDesc^.objectOwner := hWE;
  230.  
  231.         if (index >= 0) then
  232.             with sHandlerTable^^[index] do
  233.  
  234. { call the new handler, if any }
  235.                 if (newHandler <> nil) then
  236.                     begin
  237.                         err := CallNewHandler(pDesc^.objectSize, hObjectDesc, newHandler);
  238.                         if (err <> noErr) then
  239.                             begin
  240.                                 _WEForgetHandle(hObjectDesc);
  241.                                 goto 1;
  242.                             end;
  243.                     end;
  244.  
  245. { unlock the object descriptor }
  246.         HUnlock(Handle(hObjectDesc));
  247.  
  248. { clear result code }
  249.         err := noErr;
  250.  
  251. 1:
  252. { return result code }
  253.         _WENewObject := err;
  254.  
  255.     end;  { _WENewObject }
  256.  
  257.     function CallFreeHandler (hObjectDesc: WEObjectDescHandle;
  258.                                     freeHandler: ProcPtr): OSErr;
  259.     inline
  260.         $205F,                    { movea.l (sp)+, a0 }
  261.         $4E90;                    { jsr (a0) }
  262.  
  263.     function _WEFreeObject (hObjectDesc: WEObjectDescHandle): OSErr;
  264.         var
  265.             pDesc: WEObjectDescPtr;
  266.     begin
  267.         _WEFreeObject := noErr;
  268.  
  269. { sanity check: do nothing if we have a null descriptor handle }
  270.         if (hObjectDesc = nil) then
  271.             begin
  272.                 _WEFreeObject := nilHandleErr;
  273.                 Exit(_WEFreeObject);
  274.             end;
  275.  
  276. { lock the descriptor record }
  277.         HLock(Handle(hObjectDesc));
  278.         pDesc := hObjectDesc^;
  279.  
  280.         if (pDesc^.objectIndex >= 0) then
  281.             with sHandlerTable^^[pDesc^.objectIndex] do
  282.                 begin
  283.  
  284. {$IFC WASTE_DEBUG}
  285. { sanity check: make sure object kind matches handler kind }
  286.                     _WEAssert(pDesc^.objectType = objectType, 'Object Type Mismatch');
  287. {$ENDC}
  288.  
  289. { call the dispose handler, if any }
  290.                     if (freeHandler <> nil) then
  291.                         begin
  292.                             _WEFreeObject := CallFreeHandler(hObjectDesc, freeHandler);
  293.                             pDesc^.objectDataHandle := nil;
  294.                         end;
  295.                 end;
  296.  
  297. { if object kind is unknown or there's no custom dispose handler, use DisposeHandle }
  298.         _WEForgetHandle(pDesc^.objectDataHandle);
  299.  
  300. { finally, dispose of the object descriptor itself }
  301.         DisposeHandle(Handle(hObjectDesc));
  302.  
  303.     end;  { _WEFreeObject }
  304.  
  305.     function CallDrawHandler (destRect: Rect;
  306.                                     hObjectDesc: WEObjectDescHandle;
  307.                                     drawHandler: ProcPtr): OSErr;
  308.     inline
  309.         $205F,                    { movea.l (sp)+, a0 }
  310.         $4E90;                    { jsr (a0) }
  311.  
  312.     function _WEDrawObject (hObjectDesc: WEObjectDescHandle): OSErr;
  313.         var
  314.             pDesc: WEObjectDescPtr;
  315.             thePen: Point;
  316.             destRect: Rect;
  317.     begin
  318.         _WEDrawObject := noErr;
  319.  
  320. { the pen has already been set to the bottom left of the rectangle to draw }
  321.         GetPen(thePen);
  322.  
  323.         pDesc := hObjectDesc^;
  324.  
  325. { calculate the destination rectangle }
  326.         destRect.top := thePen.v - pDesc^.objectSize.v;
  327.         destRect.left := thePen.h;
  328.         destRect.bottom := thePen.v;
  329.         destRect.right := thePen.h + pDesc^.objectSize.h;
  330.  
  331. { calculate the new pen position }
  332.         thePen.h := thePen.h + pDesc^.objectSize.h;
  333.  
  334.         if (pDesc^.objectIndex >= 0) then
  335.             with sHandlerTable^^[pDesc^.objectIndex] do
  336.                 begin
  337.  
  338. {$IFC WASTE_DEBUG}
  339. { sanity check: make sure object kind matches handler kind }
  340.                     _WEAssert(pDesc^.objectType = objectType, 'Object Type Mismatch');
  341. {$ENDC}
  342.  
  343. { call the drawing handler, if any }
  344.                     if (drawHandler <> nil) then
  345.                         _WEDrawObject := CallDrawHandler(destRect, hObjectDesc, drawHandler);
  346.  
  347.                 end;
  348.  
  349. { advance the pen position }
  350.         MoveTo(thePen.h, thePen.v);
  351.  
  352.     end;  { _WEDrawObject }
  353.  
  354.     function CallClickHandler (hitPt: Point;
  355.                                     modifiers: Integer;
  356.                                     clickTime: LongInt;
  357.                                     hObjectDesc: WEObjectDescHandle;
  358.                                     clickHandler: ProcPtr): Boolean;
  359.     inline
  360.         $205F,                    { movea.l (sp)+, a0 }
  361.         $4E90;                    { jsr (a0) }
  362.  
  363.     function _WEClickObject (hitPt: Point;
  364.                                     modifiers: Integer;
  365.                                     clickTime: LongInt;
  366.                                     hObjectDesc: WEObjectDescHandle): Boolean;
  367.         var
  368.             pDesc: WEObjectDescPtr;
  369.     begin
  370.         _WEClickObject := false;        { assume we won't intercept this click }
  371.         pDesc := hObjectDesc^;
  372.  
  373.         if (pDesc^.objectIndex >= 0) then
  374.             with sHandlerTable^^[pDesc^.objectIndex] do
  375.                 begin
  376.  
  377. {$IFC WASTE_DEBUG}
  378. { sanity check: make sure object kind matches handler kind }
  379.                     _WEAssert(pDesc^.objectType = objectType, 'Object Type Mismatch');
  380. {$ENDC}
  381.  
  382. { call the click handler, if any }
  383.                     if (clickHandler <> nil) then
  384.                         _WEClickObject := CallClickHandler(hitPt, modifiers, clickTime, hObjectDesc, clickHandler);
  385.  
  386.                 end;
  387.     end;  { _WEClickObject }
  388.  
  389.     function WEInstallObjectHandler (objectType: OSType;
  390.                                     handlerSelector: OSType;
  391.                                     handler: ProcPtr): OSErr;
  392.         label
  393.             1;
  394.         var
  395.             index: Integer;
  396.             element: WEOHTableElement;
  397.             err: OSErr;
  398.     begin
  399.  
  400. { create the handler table, if it doesn't exist }
  401.         if (sHandlerTable = nil) then
  402.             begin
  403.                 err := %_NewHandle(0, Handle(sHandlerTable));
  404.                 if (err <> noErr) then
  405.                     goto 1;
  406.             end;
  407.  
  408. { look for an object handler record for the specified object type }
  409.         index := _WELookupObjectType(objectType);
  410.  
  411.         if (index = kUnknownObjectType) then
  412.             begin
  413.  
  414. { previously unknown object kind: add a new element to the handler table }
  415.                 _WEBlockClr(@element, SizeOf(element));
  416.                 element.objectType := objectType;
  417.                 index := sHandlerCount;
  418.                 err := _WEInsertSlot(sHandlerTable, @element, index, SizeOf(element));
  419.                 if (err <> noErr) then
  420.                     goto 1;
  421.  
  422. { increment handler count }
  423.                 sHandlerCount := index + 1;
  424.  
  425.             end;
  426.  
  427. { install the handler }
  428.         err := _WESetField(_WEObjectHandlerSelectorTable, handlerSelector, @handler, @sHandlerTable^^[index]);
  429.  
  430. 1:
  431. { return result code }
  432.         WEInstallObjectHandler := err;
  433.  
  434.     end;  { WEInstallObjectHandler }
  435.  
  436. end.